module Cover where

import Data.Graph.Inductive.Tree(UGr)
import Data.Graph.Inductive.Graph(nodes,outdeg,delNode,Node)

import Utils

--now there are three ways to mutate populations:
	--random for rest vertecies
	--greedyCover - the fastest
	--greedyCover2 - better result

--greedy algorithm
--determine degrees of vertecies at the begining for whole graph
greedyCover :: UGr -> [Node]
greedyCover graph = findCover allVertecies []
	where
		sortedNodeList vertecies = foldl (\list x -> insert x list) [] vertecies
			where
				insert elem list =
					case list of
						(x:xs) -> if (outdeg graph x) <= (outdeg graph elem)
								then elem : list
								else x : (insert elem xs)
						[] -> elem : []
		
		allVertecies = sortedNodeList $ nodes graph
		
		findCover vertecies cover = if (isCover cover graph)
									then cover
									else findCover (tail vertecies) $ (head vertecies) : cover

--greedy algorithm
--determine degrees of vertecies step by step for reducing graph
greedyCover2 :: UGr -> [Node]
greedyCover2 graph = findCover graph []
	where
		findMaxDegree subGraph = 
			let finder vertecies elem = 
				foldl (\x y -> if (outdeg subGraph x > outdeg subGraph y)
								then x
								else y) elem vertecies
			in
			let verteciesInGraph = nodes subGraph
			in
			finder verteciesInGraph $ head verteciesInGraph
		
		findCover subGraph cover = if (isCover cover graph)
									then cover
									else 
										let maxDegree = findMaxDegree subGraph
										in
										findCover (delNode maxDegree subGraph) $ maxDegree : cover


--give us one new cover from two old ones
crossover :: [Node] -> [Node] -> UGr -> [Node]
crossover parent1 parent2 graph = child (tableFreq parent1 parent2 []) []  graph
	where
		--bilding table of vertecies by using two covers
		tableFreq p1 p2 table = 
			case (p1,p2) of
				([],[]) -> table
				([],(x:xs)) -> tableFreq [] xs $ addIntoTable table x 1 
				((x:xs),[]) -> tableFreq xs [] $ addIntoTable table x 1 
				((x:xs),a) -> 					
        			--if we will find x in a - we must remove it and add into table with freq = 2 
        			--otherwise with freq = 1
					let findAndRem table list elem newList = 
						case list of
							(x:xs) -> if (x == elem) 
									then (newList ++ xs, addIntoTable table x 2)
									else findAndRem table xs elem $ x:newList 
							[] -> (newList, (addIntoTable table x 1))
					in
					let (list, newTable) = findAndRem table a x []
					in
					tableFreq xs list newTable
			where
				--addition into table of vertecies
				addIntoTable :: [Node] -> Node -> Int -> [Node]
				addIntoTable table elem freq =
					case table of
						[] -> (elem:[])
						(x:xs) -> if (((outdeg graph x)>(outdeg graph elem)) ||
									(((outdeg graph x)==(outdeg graph elem)) && (freq==1)))
								then (x:(addIntoTable xs elem freq))
								else (elem:x:xs)
						
		--we will take per one vertex from table until there will not any free edges in graph
		child table son graph 
			| isThereNoEdge graph = son
			| otherwise = child (tail table) ((head table):son) $ delNode (head table) graph

--to make different cover
mutationSimple :: UGr -> [Node] -> IO [Node]
mutationSimple graph cover = do
	randomVertex <- pick $ nodes $ removeAll cover graph
	let mutation proposition subGraph 
		| isCover proposition graph = proposition
		| otherwise =
			proposition ++ (greedyCover subGraph)
	return $ mutation (randomVertex:[]) $ delNode randomVertex graph

--return new population by giving old one
population :: [[Node]] -> UGr -> IO [[Node]]
population old graph = do
	newHalf <- partPopulation old []
	return $ merge (\ l1 l2 -> if (length l1)<(length l2) then -1 else 1) 
					newHalf $ halfOfList old
	where
		--it's children of old population
		partPopulation oldOne newOne = 
			case oldOne of
				(x:xx:xs) -> do
					mutant <- mutationSimple graph $ crossover x xx graph
					partPopulation xs $ addIntoList newOne mutant
				(x:[]) -> do
					mutant <- mutationSimple graph x
					return $ addIntoList newOne mutant
				[] -> do 
					return newOne

--allow us get the exact number of populations
newPop :: Int -> [[Node]] -> UGr -> IO ([[Node]],Int)
newPop number oldPop graph = usefullPop 1 oldPop 1
	where
		usefullPop num old usefull
			| num == number = do return (old,usefull) 
			| otherwise = do
				let oldSize = length $ head old
				pop <- population old graph
				let uses = if oldSize > (length $ head pop)
						then num
						else usefull
				usefullPop (num+1) pop uses

--algorithm itself
geneticAlgorithm :: UGr -> Int -> IO ([Node],Int)
geneticAlgorithm graph numberOfPopulations = do
	--every list is graph without one verties - it is vertex cover too
	let firstPopulation =
		let someCover oldOne newOne population = 
			case newOne of
				(x:xs) -> someCover (x : oldOne) xs ((xs ++ oldOne) : population)
				[] -> population
		in
		someCover [] (nodes graph) []
	(listOfPop, usefullNum) <- newPop numberOfPopulations firstPopulation graph
	return (head listOfPop, usefullNum)
